home *** CD-ROM | disk | FTP | other *** search
/ FishMarket 1.0 / FishMarket v1.0.iso / fishies / 376-400 / disk_386 / xlispstat / src1.lzh / XLisp / xlimage.c < prev    next >
C/C++ Source or Header  |  1990-10-04  |  9KB  |  393 lines
  1. /* xlimage - xlisp memory image save/restore functions */
  2. /* Copyright (c) 1989, by David Michael Betz.                            */
  3. /* You may give out copies of this software; for conditions see the file */
  4. /* COPYING included with this distribution.                              */
  5.  
  6. #include <string.h>
  7. #include <stdlib.h>
  8. #include "xlisp.h"
  9. #include "osdef.h"
  10. #ifdef ANSI
  11. #include "xlproto.h"
  12. #include "osproto.h"
  13. #else
  14. #include "xlfun.h"
  15. #include "osfun.h"
  16. #endif ANSI
  17. #include "xlvar.h"
  18.  
  19. #ifdef SAVERESTORE
  20.  
  21. /* forward declarations */
  22. #ifdef ANSI
  23. OFFTYPE readptr(void),cvoptr(LVAL);
  24. LVAL cviptr(OFFTYPE);
  25. void freeimage(void),setoffset(void),writenode(LVAL),writeptr(OFFTYPE),
  26.      readnode(int,LVAL);
  27. #else
  28. OFFTYPE readptr(),cvoptr();
  29. LVAL cviptr();
  30. void freeimage(),setoffset(),writenode(),writeptr(),
  31.      readnode();
  32. #endif ANSI
  33.  
  34. /* local variables */
  35. static OFFTYPE off,foff,doff;
  36. static FILE *fp;
  37.  
  38. /* xlisave - save the memory image */
  39. int xlisave(fname)
  40.   char *fname;
  41. {
  42.     char fullname[STRMAX+1];
  43.     unsigned char *cp;
  44.     SEGMENT *seg;
  45.     int n,i,max;
  46.     LVAL p;
  47.  
  48.     /* default the extension */
  49.     if (needsextension(fname)) {
  50.     strcpy(fullname,fname);
  51.     strcat(fullname,".wks");
  52.     fname = fullname;
  53.     }
  54.  
  55.     /* open the output file */
  56.     if ((fp = osbopen(fname,"w")) == NULL)
  57.     return (FALSE);
  58.  
  59.     /* first call the garbage collector to clean up memory */
  60.     gc();
  61.  
  62.     /* write out the pointer to the *obarray* symbol */
  63.     writeptr(cvoptr(obarray));
  64.  
  65.     /* setup the initial file offsets */
  66.     off = foff = (OFFTYPE)2;
  67.  
  68.     /* write out all nodes that are still in use */
  69.     for (seg = segs; seg != NULL; seg = seg->sg_next) {
  70.     p = &seg->sg_nodes[0];
  71.     for (n = seg->sg_size; --n >= 0; ++p, off += 2)
  72.         switch (ntype(p)) {
  73.         case FREE:
  74.         break;
  75.         case CONS:
  76.         case USTREAM:
  77.         setoffset();
  78.         osbputc(p->n_type,fp);
  79.         writeptr(cvoptr(car(p)));
  80.         writeptr(cvoptr(cdr(p)));
  81.         foff += 2;
  82.         break;
  83.         default:
  84.         setoffset();
  85.         writenode(p);
  86.         break;
  87.         }
  88.     }
  89.  
  90.     /* write the terminator */
  91.     osbputc(FREE,fp);
  92.     writeptr((OFFTYPE)0);
  93.  
  94.     /* write out data portion of vector-like nodes */
  95.     for (seg = segs; seg != NULL; seg = seg->sg_next) {
  96.     p = &seg->sg_nodes[0];
  97.     for (n = seg->sg_size; --n >= 0; ++p)
  98.         switch (ntype(p)) {
  99.         case SYMBOL:
  100.         case OBJECT:
  101.         case VECTOR:
  102.         case CLOSURE:
  103.         case COMPLEX:           /* L. Tierney */
  104.         case DISPLACED_ARRAY:   /* L. Tierney */
  105.         case STRUCT:
  106.         max = getsize(p);
  107.         for (i = 0; i < max; ++i)
  108.             writeptr(cvoptr(getelement(p,i)));
  109.         break;
  110.         case STRING:
  111.         max = getslength(p);
  112.         for (cp = getstring(p); --max >= 0; )
  113.             osbputc(*cp++,fp);
  114.         break;
  115.         }
  116.     }
  117.  
  118.     /* close the output file */
  119.     osclose(fp);
  120.  
  121.     /* return successfully */
  122.     return (TRUE);
  123. }
  124.  
  125. /* xlirestore - restore a saved memory image */
  126. int xlirestore(fname)
  127.   char *fname;
  128. {
  129.     extern FUNDEF funtab[];
  130.     char fullname[STRMAX+1];
  131.     unsigned char *cp;
  132.     int n,i,max,type;
  133.     SEGMENT *seg;
  134.     LVAL p;
  135.  
  136.     /* default the extension */
  137.     if (needsextension(fname)) {
  138.     strcpy(fullname,fname);
  139.     strcat(fullname,".wks");
  140.     fname = fullname;
  141.     }
  142.  
  143.     /* open the file */
  144.     if ((fp = osbopen(fname,"r")) == NULL)
  145.     return (FALSE);
  146.  
  147.     /* free the old memory image */
  148.     freeimage();
  149.  
  150.     /* initialize */
  151.     off = (OFFTYPE)2;
  152.     total = nnodes = nfree = 0L;
  153.     fnodes = NIL;
  154.     segs = lastseg = NULL;
  155.     nsegs = gccalls = 0;
  156.     xlenv = xlfenv = xldenv = s_gchook = s_gcflag = NIL;
  157.     xlstack = xlstkbase + EDEPTH;
  158.     xlcontext = NULL;
  159.  
  160.     /* create the fixnum segment */
  161.     if ((fixseg = newsegment(SFIXSIZE)) == NULL)
  162.     xlfatal("insufficient memory - fixnum segment");
  163.  
  164.     /* create the character segment */
  165.     if ((charseg = newsegment(CHARSIZE)) == NULL)
  166.     xlfatal("insufficient memory - character segment");
  167.  
  168.     /* read the pointer to the *obarray* symbol */
  169.     obarray = cviptr(readptr());
  170.  
  171.     /* read each node */
  172.     while ((type = osbgetc(fp)) >= 0)
  173.     switch (type) {
  174.     case FREE:
  175.         if ((off = readptr()) == (OFFTYPE)0)
  176.         goto done;
  177.         break;
  178.     case CONS:
  179.     case USTREAM:
  180.         p = cviptr(off);
  181.         p->n_type = type;
  182.         p->n_flags = 0;
  183.         rplaca(p,cviptr(readptr()));
  184.         rplacd(p,cviptr(readptr()));
  185.         off += 2;
  186.         break;
  187.     default:
  188.         readnode(type,cviptr(off));
  189.         off += 2;
  190.         break;
  191.     }
  192. done:
  193.  
  194.     /* read the data portion of vector-like nodes */
  195.     for (seg = segs; seg != NULL; seg = seg->sg_next) {
  196.     p = &seg->sg_nodes[0];
  197.     for (n = seg->sg_size; --n >= 0; ++p)
  198.         switch (ntype(p)) {
  199.         case SYMBOL:
  200.         case OBJECT:
  201.         case VECTOR:
  202.         case CLOSURE:
  203.         case COMPLEX:         /* L. Tierney */
  204.         case DISPLACED_ARRAY: /* L. Tierney */
  205.         case STRUCT:
  206.         max = getsize(p);
  207.         if ((p->n_vdata = (LVAL *)malloc(max * sizeof(LVAL))) == NULL)
  208.             xlfatal("insufficient memory - vector");
  209.         total += (long)(max * sizeof(LVAL));
  210.         for (i = 0; i < max; ++i)
  211.             setelement(p,i,cviptr(readptr()));
  212.         break;
  213.         case STRING:
  214.         max = getslength(p);
  215.         if ((p->n_string = (unsigned char *)malloc(max)) == NULL)
  216.             xlfatal("insufficient memory - string");
  217.         total += (long)max;
  218.         for (cp = getstring(p); --max >= 0; )
  219.             *cp++ = osbgetc(fp);
  220.         break;
  221.         case STREAM:
  222.         setfile(p,NULL);
  223.         break;
  224.         case SUBR:
  225.         case FSUBR:
  226.         p->n_subr = funtab[getoffset(p)].fd_subr;
  227.         break;
  228.         }
  229.     }
  230.  
  231.     /* close the input file */
  232.     osclose(fp);
  233.  
  234.     /* collect to initialize the free space */
  235.     gc();
  236.  
  237.     /* lookup all of the symbols the interpreter uses */
  238.     xlsymbols();
  239.  
  240.     /* return successfully */
  241.     return (TRUE);
  242. }
  243.  
  244. /* freeimage - free the current memory image */
  245. LOCAL void freeimage()
  246. {
  247.     SEGMENT *seg,*next;
  248.     FILE *fp;
  249.     LVAL p;
  250.     int n;
  251.  
  252.     /* free the data portion of vector-like nodes */
  253.     for (seg = segs; seg != NULL; seg = next) {
  254.     p = &seg->sg_nodes[0];
  255.     for (n = seg->sg_size; --n >= 0; ++p)
  256.         switch (ntype(p)) {
  257.         case SYMBOL:
  258.         case OBJECT:
  259.         case VECTOR:
  260.         case CLOSURE:
  261.         case COMPLEX:          /* L. Tierney */
  262.         case DISPLACED_ARRAY:  /* L. Tierney */
  263.         case STRUCT:
  264.         if (p->n_vsize)
  265.             free(p->n_vdata);
  266.         break;
  267.         case STRING:
  268.         if (getslength(p))
  269.             free(getstring(p));
  270.         break;
  271.         case STREAM:
  272.         if ((fp = getfile(p)) && (fp != stdin && fp != stdout))
  273.             osclose(getfile(p));
  274.         break;
  275.         }
  276.     next = seg->sg_next;
  277.     free(seg);
  278.     }
  279. }
  280.  
  281. /* setoffset - output a positioning command if nodes have been skipped */
  282. LOCAL void setoffset()
  283. {
  284.     if (off != foff) {
  285.     osbputc(FREE,fp);
  286.     writeptr(off);
  287.     foff = off;
  288.     }
  289. }
  290.  
  291. /* writenode - write a node to a file */
  292. LOCAL void writenode(node)
  293.   LVAL node;
  294. {
  295.     char *p = (char *)&node->n_info;
  296.     int n = sizeof(union ninfo);
  297.     osbputc(node->n_type,fp);
  298.     while (--n >= 0)
  299.     osbputc(*p++,fp);
  300.     foff += 2;
  301. }
  302.  
  303. /* writeptr - write a pointer to a file */
  304. LOCAL void writeptr(off)
  305.   OFFTYPE off;
  306. {
  307.     char *p = (char *)&off;
  308.     int n = sizeof(OFFTYPE);
  309.     while (--n >= 0)
  310.     osbputc(*p++,fp);
  311. }
  312.  
  313. /* readnode - read a node */
  314. LOCAL void readnode(type, node)
  315.   int type; LVAL node;
  316. {
  317.     char *p = (char *)&node->n_info;
  318.     int n = sizeof(union ninfo);
  319.     node->n_type = type;
  320.     node->n_flags = 0;
  321.     while (--n >= 0)
  322.     *p++ = osbgetc(fp);
  323. }
  324.  
  325. /* readptr - read a pointer */
  326. LOCAL OFFTYPE readptr()
  327. {
  328.     OFFTYPE off;
  329.     char *p = (char *)&off;
  330.     int n = sizeof(OFFTYPE);
  331.     while (--n >= 0)
  332.     *p++ = osbgetc(fp);
  333.     return (off);
  334. }
  335.  
  336. /* cviptr - convert a pointer on input */
  337. LOCAL LVAL cviptr(o)
  338.   OFFTYPE o;
  339. {
  340.     OFFTYPE off = (OFFTYPE)2;
  341.     SEGMENT *seg;
  342.  
  343.     /* check for nil */
  344.     if (o == (OFFTYPE)0)
  345.     return ((LVAL)o);
  346.  
  347.     /* compute a pointer for this offset */
  348.     for (seg = segs; seg != NULL; seg = seg->sg_next) {
  349.     if (o >= off && o < off + (OFFTYPE)(seg->sg_size << 1))
  350.         return (seg->sg_nodes + ((int)(o - off) >> 1));
  351.     off += (OFFTYPE)(seg->sg_size << 1);
  352.     }
  353.  
  354.     /* create new segments if necessary */
  355.     for (;;) {
  356.  
  357.     /* create the next segment */
  358.     if ((seg = newsegment(anodes)) == NULL)
  359.         xlfatal("insufficient memory - segment");
  360.  
  361.     /* check to see if the offset is in this segment */
  362.     if (o >= off && o < off + (OFFTYPE)(seg->sg_size << 1))
  363.         return (seg->sg_nodes + ((int)(o - off) >> 1));
  364.     off += (OFFTYPE)(seg->sg_size << 1);
  365.     }
  366. }
  367.  
  368. /* cvoptr - convert a pointer on output */
  369. LOCAL OFFTYPE cvoptr(p)
  370.   LVAL p;
  371. {
  372.     OFFTYPE off = (OFFTYPE)2;
  373.     SEGMENT *seg;
  374.  
  375.     /* check for nil and small fixnums */
  376.     if (p == NIL)
  377.     return ((OFFTYPE)p);
  378.  
  379.     /* compute an offset for this pointer */
  380.     for (seg = segs; seg != NULL; seg = seg->sg_next) {
  381.     if (CVPTR(p) >= CVPTR(&seg->sg_nodes[0]) &&
  382.         CVPTR(p) <  CVPTR(&seg->sg_nodes[0] + seg->sg_size))
  383.         return (off + (OFFTYPE)((p - seg->sg_nodes) << 1));
  384.     off += (OFFTYPE)(seg->sg_size << 1);
  385.     }
  386.  
  387.     /* pointer not within any segment */
  388.     xlerror("bad pointer found during image save",p);
  389. }
  390.  
  391. #endif SAVERESTORE
  392.  
  393.